perm filename ANI.SAI[TMP,LCS]1 blob sn#142501 filedate 1975-01-25 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "TST"
C00006 ENDMK
C⊗;
BEGIN "TST"
	REQUIRE "GEOMES.HDR[SAI,BGB]" SOURCE_FILE;
	EXTERNAL SIMPLE REAL PROCEDURE ACOS(REAL X);
	DEFINE SUBR="SIMPLE INTEGER PROCEDURE";
	SUBR FHW(INTEGER Q);START_CODE HLRZ 1,Q;END;
	SUBR LHW(INTEGER Q);START_CODE HRRZ 1,Q;END;
	STRING STR;
	INTEGER CI,TS,CB,FR,CHR,N,I,NF,LP;
	INTEGER TF,LN,NT,TH,CA,CS;

	REAL CWX,CWY,CWZ;
	SAFE INTEGER ARRAY IA[1:300];

SUBR ADN;
BEGIN
	OUTSTR("	NUM. OF FRAMES = ");
	STR←INCHWL;
	IF LENGTH(STR)=0 THEN RETURN(-1);
	NF←INTSCAN(STR,CHR);CB←DAD(TS);
	IF CA THEN BEGIN
	  IA[CA]←(IZ(CB)-IA[CA])/NF;
	  IA[CA+1]←XWD(N,NF);
	END ELSE CS←N;
	CA←N;IA[N]←IZ(CB);IA[N+1]←0;N←N+2;
	CB←TS;
	WHILE TS≠(CB←CW(CB)) DO BEGIN
	  FR←ALT2(CB);
	  IF (NT←PLINK(CB)) THEN BEGIN
	    LP←IA[NT];CWX←XWC(LP);CWY←YWC(LP);CWZ←ZWC(LP);
	    APTRAM(INTRAM(LP),FR);MKROTV(LP);
	    LN←MKTRMV(XWC(LP)/NF,YWC(LP)/NF,ZWC(LP)/NF);
	BEGIN "TEX"
	    KLNODE(LP);
	END "TEX";
	    XWC(LN)←(XWC(FR)-CWX)/NF;
	    YWC(LN)←(YWC(FR)-CWY)/NF;
	    ZWC(LN)←(ZWC(FR)-CWZ)/NF;
	    IA[NT]←LN;IA[NT+1]←XWD(N,NF);
	  END ELSE BEGIN 
	    NLINK$(N,CB);IA[N]←XWD(N+1,NF);N←N+1;
	  END;
	  LP←MKCOPY(FR);IA[N]←LP;
	  PLINK$(N,CB);IA[N+1]←0;N←N+2;
	END;
END;

SUBR MKMOVI;
BEGIN
	OUTSTR("	TOTAL NUM. OF FRAMES = ");
	CB←TS;I←0;STR←INCHWL;NT←IA[CS+1];CA←LHW(NT);
	IF LENGTH(STR)≠0 THEN TF←INTSCAN(STR,CHR);
	WHILE TS≠(CB←CW(CB)) DO BDET(CB);
	WHILE (I←I+1)≤TF DO BEGIN
	  IF CI="M" THEN BEGIN
	    SHOW2(0,1);PLOTO("MOVIE."&CVS(I));CB←TS;
	  END ELSE GEODPY;
	  IF CA=0 THEN BEGIN
	    NT←IA[CS+1];CA←LHW(NT);CS←FHW(NT);
	  END;
	  FR←DAD(TS);IX(FR)←IX(FR)+IA[CS];CA←CA-1;
	  WHILE TS≠(CB←CW(CB)) DO BEGIN
	    TH←NLINK(CB);LN←IA[TH];NF←LHW(LN);NT←FHW(LN);
	    IF NF≤0 THEN BEGIN
	      LN←IA[NT+1];NF←LHW(LN);NT←FHW(LN);
	    END;
	    LP←IA[NT];APTRAM(CB,LP);
	    NF←NF-1;IA[TH]←XWD(NT,NF);
	  END;
	END;
END;

	MKUNIV;GEODPY;CI←"G";N←1;TS←DAD(UNIVERSE);
	WHILE TRUE DO BEGIN
	 IF CI="G" THEN GEOMED;
	 CI←INCHRW;
	 IF CI="A" THEN BEGIN ADN;GEOMED;END;
	 IF CI="R"∨CI="M" THEN BEGIN MKMOVI;GEOMED;END;
	END;
END "TST";